home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / databa_1 / database.bas next >
BASIC Source File  |  1999-07-10  |  15KB  |  387 lines
  1. Attribute VB_Name = "DataBaseApp"
  2. ' DataBaseApp.bas
  3. '
  4. ' By Herman Liu
  5. '
  6. ' An extract from an actual application of mine (with modifications to reduce extra features,
  7. ' e.g. option to use query, allowance for change of fields, and search facilities).
  8. ' -----------------------------------------------------------------------------------------
  9. ' -----------------------------------------------------------------------------------------
  10. ' PURPOSES:
  11. ' (1) To show how to use the ADO Schema to obtain a list of tables of a database.
  12. ' (2) To show how to provide a re-usable single form (the same form can be used for any
  13. '     MDB file name, and another form can be used to display as many tables as there are
  14. '     in that database. Otherwise, you will need 10 forms if there are 10 tables).
  15. ' (3) To show the possible techniques to enable opening several tables on the screen in
  16. '     the same session (using the same form) yet without conflict.
  17. ' (4) To show how to display various attributes/properties in descriptive text which is
  18. '     more understandable, rather than the VB's original numeric codes.
  19. '
  20. ' REMARKS:
  21. ' MDI form
  22. '   "Window" menu is provided so that you can switch between tables opened, if you
  23. '       open more than one on the screen.
  24. ' TABLES form
  25. '   (1) Double click a field name will display field properties (alternatively highlight
  26. '       that field name and click "Field Property" button).
  27. '   (2) Double click a table name will invokd the GRID form (alternatively highlight
  28. '       that table name and click "Table" button).
  29. ' GRID form
  30. '   (1) Click the tiny colored buttons below the Grid will show various attributes/
  31. '       properties.
  32. ' -----------------------------------------------------------------------------------------
  33. '
  34.  
  35. Option Explicit
  36.  
  37. Public gFileSpec As String               ' Filespec of MDB
  38. Public gTableName As String              ' Table name of selected MDB
  39. Public gstrFields() As String
  40. Public gstrFieldsOrig() As String
  41.  
  42. Public gfso As FileSystemObject
  43. Public gcdg As Object
  44.  
  45. Public gAcnn As adodb.Connection
  46. Public gstrCNN As String
  47.  
  48. ' Exclude fields for null terminated string and fields for pictures
  49. Public Const gconexcludeFieldTypes = "  8/128/204/205"
  50.  
  51.  
  52.  
  53. Sub Main()
  54.     Set gfso = New FileSystemObject
  55.     Set gcdg = frmFrame.CommonDialog1
  56.     
  57.     gFileSpec = ""
  58.     gTableName = ""
  59.     
  60.     frmFrame.Show
  61. End Sub
  62.  
  63.  
  64.  
  65. Sub DBFilesMDBproc()
  66.     On Error GoTo errhandler
  67.     
  68.     ' Obtain gFileSpec
  69.     Dim i As Integer
  70.     If GetFileSpec("(*.mdb)|*.mdb") = True Then
  71.          If UCase(Right(gFileSpec, 4)) <> ".MDB" Then
  72.              MsgBox "Please select a .MDB file"
  73.              Exit Sub
  74.          End If
  75.          
  76.          Set gAcnn = New adodb.Connection
  77.          gAcnn.CursorLocation = adUseClient
  78.          gstrCNN = "PROVIDER=Microsoft.Jet.OLEDB.4.0;" & _
  79.             "Data Source=" & gFileSpec & ";"
  80.  
  81.             ' Only gAcnn, not gRcnn
  82.          If (gAcnn.Errors.Count > 0) Then
  83.              ' Just Display The First Error In The Collection
  84.             MsgBox "Error: " & gAcnn.Errors(0).Description, _
  85.                  0, "Connect Error!"
  86.             Exit Sub
  87.          End If
  88.          
  89.          frmTablesTVW.Show
  90.     End If
  91.     Exit Sub
  92.     
  93.   ' Provided a way to exit, if error occurred in called form
  94.   ' forcing it to be closed
  95. errhandler:
  96.     ErrMsgProc "basMain DBFilesMDBProc"
  97. End Sub
  98.  
  99.  
  100.  
  101.  
  102. Function GetFileSpec(ByVal strFilter As String) As Boolean
  103.     On Error GoTo errhandler
  104.  
  105.     Dim tmpfile As String
  106.     tmpfile = gFileSpec
  107.    
  108.     Do
  109.         frmFrame.CommonDialog1.CancelError = True
  110.         frmFrame.CommonDialog1.FileName = tmpfile
  111.         frmFrame.CommonDialog1.Filter = strFilter
  112.         frmFrame.CommonDialog1.ShowOpen
  113.         
  114.         If frmFrame.CommonDialog1.FileName = "" Then
  115.             Exit Do
  116.         End If
  117.     
  118.         tmpfile = frmFrame.CommonDialog1.FileName
  119.         
  120.         If gfso.FileExists(tmpfile) = True Then
  121.             Exit Do
  122.         End If
  123.         
  124.         MsgBox "File specification not found.  Please re-try"
  125.     Loop
  126.     
  127.     If tmpfile <> "" Then
  128.         gFileSpec = tmpfile
  129.         GetFileSpec = True
  130.     Else
  131.         GetFileSpec = False
  132.     End If
  133.     
  134.     Exit Function
  135.     
  136. errhandler:
  137.    GetFileSpec = False
  138.    If Err.Number <> 32755 Then
  139.        ErrMsgProc "basMain GetFileSpec"
  140.    End If
  141. End Function
  142.  
  143.  
  144.  
  145. Sub ErrMsgProc(mMsg As String)
  146.     MsgBox mMsg & vbCrLf & Err.Number & Space(5) & Err.Description
  147. End Sub
  148.  
  149.  
  150.  
  151. ' Convert the numeric value returned by DB to Enum, so
  152. ' that at least the user could have a guess of what it is.
  153. Function ConvType(ByVal TypeVal As Long) As String
  154.   Select Case TypeVal
  155.       Case adBigInt                    ' 20
  156.          ConvType = "adBigInt"
  157.       Case adBinary                    ' 128
  158.          ConvType = "adBinary"
  159.       Case adBoolean                   ' 11
  160.          ConvType = "adBoolean"
  161.       Case adBSTR                      ' 8 i.e. null terminated string
  162.          ConvType = "adBSTR"
  163.       Case adChar                      ' 129
  164.          ConvType = "adChar"
  165.       Case adCurrency                  ' 6
  166.          ConvType = "adCurrency"
  167.       Case adDate                      ' 7
  168.          ConvType = "adDate"
  169.       Case adDBDate                    ' 133
  170.          ConvType = "adDBDate"
  171.       Case adDBTime                    ' 134
  172.          ConvType = "adDBTime"
  173.       Case adDBTimeStamp               ' 135
  174.          ConvType = "adDBTimeStamp"
  175.       Case adDecimal                   ' 14
  176.          ConvType = "adDecimal"
  177.       Case adDouble                    ' 5
  178.          ConvType = "adDouble"
  179.       Case adEmpty                     ' 0
  180.          ConvType = "adEmpty"
  181.       Case adError                     ' 10
  182.          ConvType = "adError"
  183.       Case adGUID                      ' 72
  184.          ConvType = "adGUID"
  185.       Case adIDispatch                 ' 9
  186.          ConvType = "adIDispatch"
  187.       Case adInteger                   ' 3
  188.          ConvType = "adInteger"
  189.       Case adIUnknown                  ' 13
  190.          ConvType = "adIUnknown"
  191.       Case adLongVarBinary             ' 205
  192.          ConvType = "adLongVarBinary"
  193.       Case adLongVarChar               ' 201
  194.          ConvType = "adLongVarChar"
  195.       Case adLongVarWChar              ' 203
  196.          ConvType = "adLongVarWChar"
  197.       Case adNumeric                  ' 131
  198.          ConvType = "adNumeric"
  199.       Case adSingle                    ' 4
  200.          ConvType = "adSingle"
  201.       Case adSmallInt                  ' 2
  202.          ConvType = "adSmallInt"
  203.       Case adTinyInt                   ' 16
  204.          ConvType = "adTinyInt"
  205.       Case adUnsignedBigInt            ' 21
  206.          ConvType = "adUnsignedBigInt"
  207.       Case adUnsignedInt               ' 19
  208.          ConvType = "adUnsignedInt"
  209.       Case adUnsignedSmallInt          ' 18
  210.          ConvType = "adUnsignedSmallInt"
  211.       Case adUnsignedTinyInt           ' 17
  212.          ConvType = "adUnsignedTinyInt"
  213.       Case adUserDefined               ' 132
  214.          ConvType = "adUserDefined"
  215.       Case adVarBinary                 ' 204
  216.          ConvType = "adVarBinary"
  217.       Case adVarChar                   ' 200
  218.          ConvType = "adVarChar"
  219.       Case adVariant                   ' 12
  220.          ConvType = "adVariant"
  221.       Case adVarWChar                  ' 202
  222.          ConvType = "adVarWChar"
  223.       Case adWChar                     ' 130
  224.          ConvType = "adWChar"
  225.    End Select
  226. End Function
  227.  
  228.  
  229.  
  230. Function ConvAttr(ByVal mAttr As Long) As String
  231.     ' Note value of mAttr is often a combination of several values
  232.     ' hence chances are "Unknown" in the following
  233.     Select Case mAttr
  234.        Case (mAttr And adFldMayDefer)
  235.            ConvAttr = "adFldMayDefer "            '2
  236.        Case (mAttr And adFldUpdatable)
  237.            ConvAttr = "adFldUpdatable "           '4
  238.        Case (mAttr And adFldUnknownUpdatable)
  239.            ConvAttr = "adFldUnknownUpdatable "    '8
  240.        Case (mAttr And adFldFixed)
  241.            ConvAttr = "adFldFixed "               '16
  242.        Case (mAttr A